home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / twotap.exe / TWOTAPLB.BAS < prev   
Encoding:
BASIC Source File  |  1991-12-23  |  6.8 KB  |  232 lines
  1. DEFINT A-Z
  2. DECLARE SUB blink (blinkLine%, blinkText$)
  3. DECLARE SUB editor (Text$, dline%, leftCol%, rightCol%, keycode%)
  4. DECLARE SUB mainMenu ()
  5. DECLARE SUB FkeySelect (FkeyPressed%)
  6. DECLARE SUB center (linenumber%, centeredText$)
  7. DECLARE SUB clearline (linenumber%)
  8. DECLARE SUB drawBox (row1, col1, row2, col2)
  9.  
  10. '    twotapLB.bas  - 'generic' SUBs for twotap.bas
  11. '
  12. '    You may eventually want to incorporate these routines into
  13. '    a .LIB file, they are general in their function, not just for
  14. '    the TWOTAP.BAS program.
  15. '
  16. '
  17.  
  18. SUB center (linenumber, centeredText$)
  19. 'centers a line of text on designated line.
  20.  
  21.         IF LEN(centeredText$) > 76 THEN centeredText$ = LEFT$(centeredText$, 76)
  22.         tabPoint = (80 - LEN(centeredText$)) \ 2
  23.         IF tabPoint = 0 THEN tabPoint = 1
  24.         IF linenumber = 0 THEN linenumber = 1
  25.         LOCATE linenumber, tabPoint, 0: PRINT centeredText$;
  26.  
  27. END SUB
  28.  
  29. SUB drawBox (row1, col1, row2, col2)
  30.  
  31.       ' calculate the width of the box
  32.  
  33.         wide% = col2 - col1 - 1
  34.       
  35.       ' Now draw the top of the box
  36.  
  37.         LOCATE row1, col1, 0
  38.         PRINT CHR$(201);
  39.         PRINT STRING$(wide%, 205);
  40.         PRINT CHR$(187);
  41.       
  42.       ' . . . and the sides
  43.  
  44.       lastSpace$ = ""
  45.  
  46.       ' if there is room, we put a 'shadow' on the right side
  47.  
  48.       IF row2 <> 25 AND col2 <= 78 THEN lastSpace$ = "█"
  49.  
  50.         FOR row3% = row1 + 1 TO row2 - 1
  51.             LOCATE row3%, col1, 0
  52.             PRINT CHR$(186);
  53.             PRINT SPACE$(wide%);
  54.             PRINT CHR$(186);
  55.             PRINT lastSpace$;
  56.         NEXT row3%
  57.  
  58.         IF row2 < 25 AND col2 <= 79 THEN
  59.             LOCATE CSRLIN + 1, POS(0) - 1
  60.             PRINT lastSpace$;
  61.             END IF
  62.       
  63.       ' now draw the bottom of the box
  64.  
  65.         LOCATE row2, col1, 0
  66.         PRINT CHR$(200);
  67.         PRINT STRING$(wide%, 205);
  68.         PRINT CHR$(188);
  69.  
  70.       '  do shadow if there is room
  71.  
  72.         IF row2 <> 25 AND col2 <= 79 THEN
  73.             LOCATE row2 + 1, col1 + 3, 0
  74.             PRINT STRING$(wide%, 219);
  75.             END IF
  76.       
  77. END SUB
  78.  
  79. SUB FkeySelect (FkeyPressed)
  80.  
  81. keyPress$ = ""
  82. FkeyPressed = 0
  83.  
  84. DO UNTIL keyPress$ > ""
  85.     keyPress$ = INKEY$
  86. LOOP
  87.  
  88.     IF LEN(keyPress$) <> 2 THEN
  89.  
  90.         '  good programming will always let an ESC key press back out
  91.         '  of what the operator is doing.  ESC is CHR$(27), so this IF
  92.         '  block lets the operator quit even though we want an F key only.
  93.  
  94.         IF keyPress$ = CHR$(27) THEN
  95.             center 24, "    You pressed the ESC key     "
  96.             SLEEP 1
  97.             FkeyPressed = 27
  98.             EXIT SUB
  99.             END IF
  100.         SOUND 1600, 1
  101.         '
  102.         '  It would be a nice touch, if you have access to PDS 7.1, to
  103.         '  use the assembly lanuguage routines (a library) that are
  104.         '  called by the getBackground and putBackground SUBs in the
  105.         '  windows.bas program in the User Interface library.  They
  106.         '  capture and restore portions of the screen very quickly.
  107.         '  for this system to be "free standing" we remmed out these
  108.         '  lines and just "blank" the phrase we print on line 24
  109.  
  110.         'getbackground 24, 1, 25, 80, line25$
  111.  
  112.         center 24, "       F keys only here       "
  113.         SLEEP 1: center 24, SPACE$(70)
  114.         center 24, "       Touch an F key to Select.         "
  115.  
  116.         'putBackground 24, 1, line25$
  117.  
  118.         FkeySelect FkeyPressed
  119.         END IF
  120.  
  121.     IF LEN(keyPress$) = 2 THEN
  122.         FkeyPressed$ = RIGHT$(keyPress$, 1)
  123.         FkeyPressed = ASC(FkeyPressed$)
  124.         FkeyPressed = FkeyPressed - 58
  125.     END IF
  126.  
  127.     IF FkeyPressed = 76 THEN FkeyPressed = 12: EXIT SUB
  128.     IF FkeyPressed = 75 THEN FkeyPressed = 11: EXIT SUB
  129.     IF FkeyPressed >= 1 AND FkeyPressed <= 10 THEN EXIT SUB
  130.  
  131.     SOUND 1200, 1
  132.     'getbackground 24, 1, 25, 80, line25$
  133.     center 24, "       F keys only here       "
  134.     SLEEP 1: center 24, SPACE$(70)
  135.     'putBackground 24, 1, line25$
  136.     keyPress$ = ""
  137.     FkeyPressed$ = ""
  138.     FkeyPressed = 0
  139.     FkeySelect FkeyPressed
  140.  
  141. END SUB
  142.  
  143. SUB screenTexture
  144. CLS                     ' don't seem to be able to avoid blinking
  145. 'EXIT SUB
  146.  
  147. FOR sf = 1 TO 24
  148.     PRINT STRING$(80, 176);           ' fills screen with ░
  149. NEXT sf
  150.  
  151. END SUB
  152.  
  153. SUB shareWare
  154.  
  155. DIM m$(1 TO 32)
  156.  
  157.     m$(1) = " This program is distributed under the 'Shareware' Concept."
  158.     m$(2) = ""
  159.     m$(3) = "That is:  You can 'Try Before You Buy.'"
  160.     m$(4) = ""
  161.     m$(5) = "You get a fully functioning program -- in this particular case"
  162.     m$(6) = "even source code -- for free, or at least nominal download,"
  163.     m$(7) = "disk duplication/distribution expense."
  164.     m$(8) = ""
  165.     m$(9) = "If you find the program useful, you can support the "
  166.     m$(10) = "concept of Shareware by registering it for $25 (US Funds)"
  167.     m$(11) = ""
  168.     m$(12) = "In addition to supporting & encouraging the creation of"
  169.     m$(13) = "quality software you can try before spending a lot of money,"
  170.     m$(14) = "I will send you BONUS software:"
  171.     m$(15) = ""
  172.     m$(16) = "           1.  The Latest Version of the Program"
  173.     m$(17) = "               (Source code IS included.)"
  174.     m$(18) = ""
  175.     m$(19) = "           2.  Five (5) genuinely useful SUBs that"
  176.     m$(20) = "               enhance the operation of this program"
  177.     m$(21) = "               AND can be used in other programs you"
  178.     m$(22) = "               write ROYALTY FREE, source code included."
  179.     m$(23) = ""
  180.     m$(24) = "           3.  Free subscription to TWOTAP newsletter."
  181.     m$(25) = "               (Smart things being done with the program"
  182.     m$(26) = "               all over the world - prompt notification of"
  183.     m$(27) = "               upgrades and improvements."
  184.     m$(28) = ""
  185.     m$(29) = "To Register:  Send $25 (US Funds) to:"
  186.     m$(30) = ""
  187.     m$(31) = "Kirk Woodward d/b/a People Centered Programs ∙ PO Box 610171"
  188.     m$(32) = " Dallas, TX 76051-0171 ∙ CompuServe 70146,51 ∙ 817-488-4940"
  189.  
  190.     FOR p = 1 TO 14
  191.         PRINT ; "      "; m$(p)
  192.     NEXT p
  193.  
  194.     LOCATE 25, 28: COLOR 23, 0: PRINT " Any key continues . . . ";
  195.     SLEEP 1
  196.     LOCATE 25, 28: COLOR 15, 0: PRINT " Any key continues . . . ";
  197.     SLEEP 1
  198.     LOCATE 25, 28: COLOR 7, 0: PRINT " Any key continues . . . ";
  199.  
  200.     SLEEP
  201.     CLS
  202.  
  203.     FOR p = 15 TO 32
  204.         PRINT ; "       "; m$(p)
  205.     NEXT p
  206.  
  207.     LOCATE 25, 28: COLOR 7, 0: PRINT " Any key ends . . . ";
  208.  
  209.     SLEEP
  210.  
  211. END SUB
  212.  
  213. SUB windowBar (startBar, stopBar)
  214.  
  215. LOCATE CSRLIN, startBar: PRINT "╠"; STRING$(stopBar - startBar - 1, "═"); "╣"
  216.  
  217. END SUB
  218.  
  219. SUB windowDivider (topLine, howLong, atCol)
  220.  
  221. '   prints a verticle window bar at the column desigated
  222.  
  223.     
  224.     LOCATE topLine, atCol: PRINT "╦"
  225.     FOR b = 1 TO howLong - 1
  226.         LOCATE topLine + b, atCol: PRINT "║"
  227.     NEXT b
  228.     LOCATE CSRLIN, atCol: PRINT "╩"
  229.  
  230. END SUB
  231.  
  232.